Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/cat/handlepo.i

Text File | 1997-10-26 | 6KB | 190 lines

IMPLEMENTATION MODULE handlePool;

(*==============================================================*
 * Modul:               Verwaltet Pool von Datenbank-Handles    *
 * Autor:               Johannes G”ttker-Schnetmann             *
 * erstellt am:         09.04.1992                              *
 * letzte Žnderung am:  12.04.1992                              *
 * Version:             1.0                                     *
 * Interne Version:     V#0002                                  *
 *==============================================================*

 Aus grin.i hierhin verlagert, da das Stichwortlistenmodul auch
 Datenbankhandles ben”tigt.

 *----------------------------------------------------------------------------
 * Datum    Vers. Autor  Žnderung (Arbeitsbericht)
 *----------------------------------------------------------------------------
 * 09.04.92 0001  JGS    Erste Version
 * 12.04.92 0002  JGS    Listenhandling erweitert und verbessert
 *----------------------------------------------------------------------------
 *)

IMPORT SYSTEM;
(*-- MM2-Module -----------*)
IMPORT Lists;
IMPORT Storage;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;

(*-- Cat-Module -----------*)
IMPORT data;
IMPORT MTE;
FROM Void IMPORT v;


(* Die Handles fr den Zugriff auf die Datenbank: *)

(*
TYPE oneHandlePtr = POINTER TO oneHandleElement;
TYPE oneHandleElement =
       RECORD
         group   : CARDINAL;            (* Gruppennummer *)
         open    : CARDINAL;            (* Anzahl der offenen Fenster dazu *)
         Zugriff : data.OneGroupHandle; (* Zugriffshandle *)
       END;
*)

VAR handles : Lists.List;      (* Liste der Zugriffshandles *)

(*-- Allgemeine Listenverwaltung ---------------*)

PROCEDURE BlankToList(VAR new  : SYSTEM.ADDRESS;
                          size : LONGCARD;
                      VAR list : Lists.List):BOOLEAN;
(* Ein Listenelement an die angegebene Liste anh„ngen *)
VAR err   : BOOLEAN;
BEGIN
  Storage.ALLOCATE(new, size);
  IF new # NIL THEN
    Lists.AppendEntry(list, new, err);
    IF err THEN
      Storage.DEALLOCATE(new, 0);
      RETURN FALSE;
    ELSE
      RETURN TRUE
    END;
  ELSE
    RETURN FALSE
  END;
END BlankToList;

PROCEDURE FreeOnePtr(ptr  : SYSTEM.ADDRESS;
                 VAR list : Lists.List);
VAR found : BOOLEAN;
BEGIN
  Lists.FindEntry(list, ptr, found);
  IF found THEN
    Lists.RemoveEntry(list, v.bool);
    Storage.DEALLOCATE(ptr, 0);
  ELSE
    MTE.InfoAlert(MTE.listError1, 'Fenster-Liste', MTE.listError2);
  END;
END FreeOnePtr;

PROCEDURE FindEntry(data     : SYSTEM.ADDRESS;
                    condProc : Lists.LCondProc;
                    list     : Lists.List;
                VAR ptr      : SYSTEM.ADDRESS):BOOLEAN;
VAR found : BOOLEAN;
BEGIN
  found := FALSE;
  Lists.ResetList(list);
  Lists.ScanEntries(list, Lists.forward, condProc, data, found);
  IF found THEN
    ptr := Lists.CurrentEntry(list);
  END;
  RETURN found
END FindEntry;

(*-- Spezielle Datenbankhandleliste ------------*)

PROCEDURE SearchDataHandle(gruppe : CARDINAL;
                       VAR handle : oneHandlePtr):BOOLEAN;
(* Handle-Liste nach einem Eintrag der Gruppe <gruppe> durchsuchen *)

(*$Z-,A+*)
  PROCEDURE condProc(e, i : SYSTEM.ADDRESS):BOOLEAN;
  (* Abbruchprozedur, wie in <Lists> gefordert *)
  BEGIN
    RETURN oneHandlePtr(e)^.group = gruppe
  END condProc;
(*$Z=,A=*)
VAR found : BOOLEAN;
BEGIN
  Lists.ResetList(handles);
  Lists.ScanEntries(handles, Lists.forward, condProc, SYSTEM.ADR(gruppe), found);
  IF found THEN
    handle := Lists.CurrentEntry(handles);
  END;
  RETURN found
END SearchDataHandle;

PROCEDURE GetOneDatahandle(gruppe : CARDINAL;
                       VAR handle : oneHandlePtr):BOOLEAN;
(* Erst die bestehende Liste nach schon offenen Handles durchsuchen,
 * falls dort nicht gefunden, versuchen ein neues zu ”ffnen
 *)
 VAR found : BOOLEAN;
BEGIN
  IF SearchDataHandle(gruppe, handle) THEN
    INC(handle^.open); (* jetzt wird es von einem Fenster mehr benutzt *)
  ELSE
    IF BlankToList(handle, SYSTEM.TSIZE(oneHandleElement), handles) THEN
      IF ~data.OpenOneGroup(gruppe, 0, FALSE, handle^.Zugriff) THEN
        (* Hier interessiert nicht, was beim zurckschreiben passiert *)
        Lists.FindEntry(handles, handle, found);
        IF found THEN
          Lists.RemoveEntry(handles, v.bool);
        ELSE
          MTE.InfoAlert(MTE.listError1, 'Handle-Liste', MTE.listError2);
        END;
        DISPOSE(handle);
        RETURN FALSE
      ELSE
        handle^.group := gruppe;
        handle^.open  := 1;
      END;
    ELSE
      RETURN FALSE
    END;
  END;
  RETURN TRUE
END GetOneDatahandle;

PROCEDURE FreeOneDataHandle(handle : oneHandlePtr);
(* Nachsehen, ob er noch ben”tigt wird, sonst aus der Liste entfernen *)
VAR found : BOOLEAN;
BEGIN
  IF handle = NIL THEN RETURN END;
  IF handle^.open > 1 THEN (* = wird noch ben”tigt, aber von einem weniger *)
    DEC(handle^.open)
  ELSE (* Wird nicht mehr ben”tigt *)
    data.CloseOneGroup(handle^.Zugriff);
    (* Hier interessiert nicht, was beim zurckschreiben passiert *)
    Lists.FindEntry(handles, handle, found);
    IF found THEN
      Lists.RemoveEntry(handles, v.bool);
    ELSE
      MTE.InfoAlert(MTE.listError1, 'Handle-Liste', MTE.listError2);
    END;
    DISPOSE(handle);
  END;
END FreeOneDataHandle;

PROCEDURE InitPool():BOOLEAN;
(* Wird in grin.grinInit aufgerufen, Fehler auch dort angemeckert und braucht *)
(* nicht weiter beachtet zu werden *)
BEGIN
  Lists.CreateList(handles,  v.bool);
  RETURN ~v.bool
END InitPool;

PROCEDURE isOneGroupOpen():BOOLEAN;
(* Fragt nach, ob _irgendeine_ Gruppe noch ge”ffnet ist. Insbesondere fr   *)
(* parser.i -> Gruppe offen: Einfgen abbrechen und CAT beenden             *)
BEGIN
  RETURN ~Lists.ListEmpty(handles);
END isOneGroupOpen;

END handlePool.